home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / butt01.zip / MSGERROR.PRG < prev    next >
Text File  |  1993-01-04  |  3KB  |  91 lines
  1. *:*********************************************************************
  2. *:
  3. *:        Program: MSGERROR.PRG
  4. *:
  5. *:         System: MIS Consulting
  6. *:         Author: Charles Alan Butler
  7. *:      Copyright (c) 1989, Charles Alan Butler
  8. *:  Last modified: 09/11/89     18:44
  9. *:
  10. *:      Called by: GET_LINE                      
  11. *:               : CMDQ2.PRG                     
  12. *:               : BID_SEL.PRG                   
  13. *:               : JOBBID                        
  14. *:               : CMDQ.PRG                      
  15. *:               : JOBMEMO.PRG                   
  16. *:               : SERMEMO.PRG                   
  17. *:               : BIDMEMO.PRG                   
  18. *:
  19. *:      Documented 09/17/89 at 16:40                SNAP!  version 3.12f
  20. *:*********************************************************************
  21. **  prg to display a message
  22.  
  23. PARAMETERS MsgColor,MsgRow,MsgTxt
  24. **  MsgColor = "<Text / Background>"
  25. **  Do MsgError WITH MsgColor,MsgRow,MsgTxt
  26.  
  27. **  Requires variable 'wt' which is the WaitTime for delays, etc. (wt=90)
  28. IF TYPE('WT') = 'U'
  29.    wt = 90
  30. ENDIF
  31. IF TYPE('SSpeed') # 'N'
  32.    SSpeed = 3    &&  Requires System Speed variable to control message rate
  33. ENDIF
  34.  
  35. PRIVATE LeftCol,RightCol,TmpColor,InvColor,FlowColor,FlowDir,LC,OldRow,OldCol
  36.  
  37. TmpColor = SYS(2001,'COLOR')   &&  Save Color
  38. InvColor = SUBSTR(MsgColor,AT('/',MsgColor)+1) +'/'+LEFT(MsgColor,AT('/',MsgColor)-1)
  39. OldRow = ROW()    &&  Save row and col position
  40. OldCol = COL()
  41.  
  42. DO CASE
  43. CASE  LEN(MsgTxt) = 0
  44.    MsgTxt = 'Error - No message specified????'
  45. CASE  LEN(MsgTxt)>80
  46.    MsgTxt = LEFT(MsgTxt,80)
  47. CASE  LEN(MsgTxt)<67
  48.    MsgTxt = 'Error !! '+MsgTxt
  49. ENDCASE
  50.  
  51. MsgTxt = SPACE(40-LEN(MsgTxt)/2)+MsgTxt
  52. MsgTxt = MsgTxt+SPACE(80-LEN(MsgTxt))
  53.  
  54. ?? CHR(7)
  55. SET COLOR TO &InvColor
  56.  
  57. @ MsgRow,0 SAY SYS(2002)   && Hide Cursor
  58. @ MsgRow,0 SAY MsgTxt
  59.  
  60. LeftCol = 0
  61. FlowDir = 1
  62. cnt1 = wt/5     &&  adjust message display time
  63.  
  64. DO WHILE cnt1 > 0
  65.    lc = IIF(FlowDir=1,0,79)
  66.    FlowColor = IIF(FlowDir=1,MsgColor,InvColor)
  67.    SET COLOR TO &FlowColor
  68.    DO WHILE lc >= 0 .AND. lc < 80
  69.       @ MsgRow,lc SAY SUBSTR(MsgTxt,lc+1,1)
  70.       cnt2 = SSpeed           &&  adjust travel rate
  71.       DO WHILE cnt2 > 0
  72.          IF INKEY() > 0 .OR. cnt1 < 0
  73.             cnt1 = -1
  74.             EXIT
  75.          ENDIF
  76.          cnt2 = cnt2-1
  77.       ENDDO
  78.       lc = lc+FlowDir
  79.    ENDDO
  80.    FlowDir = IIF(FlowDir=1,-1,1)
  81.    cnt1 = cnt1-1
  82. ENDDO
  83.  
  84. *************************************************************
  85. SET COLOR TO &TmpColor
  86. @ MsgRow,0
  87. @ OldRow,OldCol SAY SYS(2002,1)   && Restore Cursor & reposition
  88.  
  89. RETURN
  90. *: EOF: MSGERROR.PRG
  91.